load('ondra_makro_promenne.Rdata')
join_list <- function(list){
tbl_res <- list[[1]]
for(i in 2:length(list)) tbl_res <- inner_join(tbl_res, list[[i]], by = 'date')
return(tbl_res)
}
tbl_final <- join_list(var_list)
Následující tabulka obsahuje makro-proměnné, tedy zatím neobsahuje dílčí ceny domů, které jsi chtěl v zadání. Jsou to tedy:
Kromě dat z ČNB pochází ze St.Louis FRED, ten je bere všude možně (OECD, Eurostat), používám protože se z něho jednoduše tahají data.
tbl_final
U některých proměnných to moc nemá smysl, zejména u úrokových měr, které se dost skokově mění a zároveň nerostou v absolutních číslech stabilně, jako např. HDP které roste v čase konstantně. Nicméně tu je graf:
tbl_final %>%
mutate(gdp = (gdp/tbl_final$gdp[which(tbl_final$date == '2010-01-01')])*100,
inflation = (inflation/tbl_final$inflation[which(tbl_final$date == '2010-01-01')])*100,
wage_med = (wage_med/tbl_final$wage_med[which(tbl_final$date == '2010-01-01')])*100,
unemp = (unemp/tbl_final$unemp[which(tbl_final$date == '2010-01-01')])*100,
hypo = (hypo/tbl_final$hypo[which(tbl_final$date == '2010-01-01')])*100) %>%
drop_na(.) %>%
pivot_longer(data = .,
cols = -date,
names_to = 'variable',
values_to = 'value') %>%
ggplot(data = .,
aes(x = date, y = value, color = variable)) + geom_line() +
scale_y_continuous(name = 'Index, základ 01/2010 = 100') +
ggtitle('Vývoj indexu jednotlivých proměnných') +
scale_x_date(date_breaks = '1 years') +
theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1)) -> plot_index
ggplotly(plot_index)
differentiate <- function(x){
ser_new = vector(mode = 'numeric', length = length(x))
for(i in 2:length(x)) ser_new[i] = x[i] - x[i - 1]
return(ser_new)
}
Nejsmysluplnější je graf tempa růstu (ten ale má smysl sledovat jen v krátkých obdobích). Pro percentuální proměnné se jedná o jednoduché diference: \(x_t^{diff} = x_t - x_{t - 1}\) Pro absolutní proměnné se jedná o tempo růstu.
tbl_final %>%
mutate(gdp = 100*(log(gdp) - lag(log(gdp))),
inflation = inflation - lag(inflation),
wage_med = wage_med - lag(wage_med),
unemp = unemp - lag(unemp),
hypo = hypo - lag(hypo),
houseprice = houseprice - lag(houseprice)) %>%
drop_na() %>%
pivot_longer(data = .,
cols = -date,
names_to = 'variable',
values_to = 'value') %>%
ggplot(data = .,
aes(x = date, y = value, color = variable)) + geom_line() +
scale_y_continuous(name = 'Rel. zmena, pct.') +
scale_x_date(date_breaks = '1 years',
date_minor_breaks = '6 months') +
theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1)) +
ggtitle('Relativni zmeny sledovanych velicin') -> plot_rel_change
ggplotly(plot_rel_change)
Podle mě nemá moc smysl chtít něco vyloženě vyčíst z grafu. Tohle je jednoduchý model založený na vzájemné provázanosti všech proměnných. Nejde totiž říct, že růst jedné proměnné vždy jednoznačně předpoví růst cen nemovitostí, což asi ani nepředpokládáš. Předpověď jsem nastavil na 6 kvartálů dopředu (tak jak jsi chtěl v mailu).
Když se podíváš na jednotlivé proměnné, řádky značí další kvartál v pořadí. Sloupce mají následující význam:
Ber to samozřejmě všechno s rezervou, pořád mi to ale přijde rozumnější, než na základě grafů chtít něco předpovídat. Až budu mít víc granurální data k cenám nemovitostí, tak ten model ještě upravím trochu.
tbl_final %>%
mutate(gdp = 100*(log(gdp) - lag(log(gdp))),
inflation = inflation - lag(inflation),
wage_med = wage_med - lag(wage_med),
unemp = unemp - lag(unemp),
hypo = hypo - lag(hypo),
houseprice = houseprice - lag(houseprice)) %>%
drop_na() %>%
dplyr::select(-date) %>%
VAR(y = .,
p = 2,
type = 'const',
season = NULL,
exog = NULL) -> var_model
predict(var_model, n.ahead = 6, CI = 0.95) -> var_prediction
fanchart(var_prediction, main = c('gdp', 'wage_med', 'hypo', 'unemp', 'inflation', 'houseprice'))
var_prediction
## $gdp
## fcst lower upper CI
## [1,] 2.3064172 -1.052785 5.665619 3.359202
## [2,] 1.5428368 -2.440803 5.526477 3.983640
## [3,] -0.1963752 -4.333140 3.940390 4.136765
## [4,] 0.9420198 -3.345629 5.229669 4.287649
## [5,] 1.1005595 -3.213250 5.414369 4.313810
## [6,] 0.6743535 -3.647108 4.995815 4.321462
##
## $hypo
## fcst lower upper CI
## [1,] -0.08636811 -0.4187047 0.2459685 0.3323366
## [2,] -0.05067688 -0.4490383 0.3476845 0.3983614
## [3,] -0.14281472 -0.5575860 0.2719566 0.4147713
## [4,] -0.23217483 -0.6517741 0.1874244 0.4195992
## [5,] -0.22453580 -0.6515864 0.2025148 0.4270506
## [6,] -0.20601114 -0.6381277 0.2261054 0.4321166
##
## $inflation
## fcst lower upper CI
## [1,] 1.150867 -0.11569123 2.417424 1.266558
## [2,] 1.350739 0.01732924 2.684149 1.333410
## [3,] 1.464399 0.02750332 2.901295 1.436896
## [4,] 1.617970 0.15230065 3.083639 1.465669
## [5,] 1.416879 -0.11035913 2.944117 1.527238
## [6,] 1.588434 0.04634742 3.130520 1.542086
##
## $wage_med
## fcst lower upper CI
## [1,] 3.096527 0.4417526 5.751302 2.654775
## [2,] 4.260478 0.9757614 7.545195 3.284717
## [3,] 2.772839 -0.9334547 6.479132 3.706293
## [4,] 4.118894 0.3605922 7.877197 3.758302
## [5,] 4.203972 0.3617888 8.046155 3.842183
## [6,] 4.111532 0.2300049 7.993060 3.881527
##
## $unemp
## fcst lower upper CI
## [1,] -0.6742368 -1.227547 -0.1209263 0.5533105
## [2,] -0.8073121 -1.479925 -0.1346987 0.6726133
## [3,] -0.5664583 -1.339185 0.2062682 0.7727265
## [4,] -0.3564607 -1.164863 0.4519413 0.8084020
## [5,] -0.3349970 -1.181963 0.5119691 0.8469661
## [6,] -0.3361590 -1.204140 0.5318217 0.8679807
##
## $houseprice
## fcst lower upper CI
## [1,] 8.849989 6.681855 11.01812 2.168133
## [2,] 8.110672 5.193693 11.02765 2.916980
## [3,] 7.410599 3.982864 10.83834 3.427736
## [4,] 7.705029 3.664012 11.74605 4.041017
## [5,] 8.049594 3.568439 12.53075 4.481155
## [6,] 8.282038 3.446817 13.11726 4.835221